home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok41 / spiele / mastermind / txt / gadget.mod < prev    next >
Text File  |  1993-11-04  |  10KB  |  318 lines
  1. (*********************************************************************
  2.  *
  3.  *  :Program.        HilfsModul für Mastermind
  4.  *  :Author.        Hans Schafft
  5.  *  :Address.        Landfriedstraße 1A - Hinterhaus
  6.  *  :Address.        6900 Heidelberg
  7.  *  :Phone.        06221 - 22416
  8.  *  :Version.        1.3
  9.  *  :Date.        6/1990
  10.  *  :Copyright.        PD
  11.  *  :Language.        Modula-II
  12.  *  :Translator.    M2Amiga
  13.  *
  14.  *********************************************************************)
  15.  
  16. IMPLEMENTATION MODULE Gadget;
  17.  
  18. FROM Abbruch    IMPORT    ZeigeAbbruch;
  19. FROM VonWem    IMPORT    ShowReq;
  20. FROM Hilfen    IMPORT    ZeigeHilfen;
  21.  
  22. FROM Arts    IMPORT    Terminate;
  23. FROM SYSTEM    IMPORT    INLINE, ADDRESS, ADR, LONGSET;
  24. FROM Graphics   IMPORT  ScrollRaster, SetAPen, RectFill,
  25.             Flood, Draw, Move, jam2, jam1;
  26. FROM Exec       IMPORT  MemReqs, MemReqSet,AvailMem,WaitPort, ReplyMsg,
  27.             CopyMem, AllocMem, FreeMem, GetMsg;
  28. FROM Intuition    IMPORT    GadgetPtr, ScreenPtr, keyCodeQ, selectDown,
  29.             IDCMPFlags, IDCMPFlagSet, PrintIText,
  30.             boolGadget, ActivationFlags,ActivationFlagSet,
  31.                 Border, Gadget, GadgetFlagSet, IntuiText,
  32.                         GadgetFlags, IntuiTextLength, gadgHighbits,
  33.                         RefreshGadgets, AddGadget, DrawBorder, gadgHNone,
  34.                         RemoveGadget,IntuiMessagePtr, WindowPtr;
  35.  
  36. VAR     BoolGad  : ARRAY [1..50] OF Gadget;
  37.     ZahlText : ARRAY [1..2] OF IntuiText;
  38.     text     : ARRAY [0..16],[1..3] OF CHAR;
  39.     wiPtr     : WindowPtr;
  40.     x,YPos     : INTEGER;
  41.     sta     : INTEGER;
  42.     rahmenWeite : INTEGER;
  43.         gadDim : ARRAY [1..30],[1..4] OF INTEGER;
  44.  
  45. (***************************************************************)
  46. PROCEDURE GadgetsLoeschen;
  47. VAR x,y : CARDINAL;
  48. BEGIN
  49.   FOR x := 1 TO 30+sta DO
  50.     y := RemoveGadget(wiPtr,ADR(BoolGad[x]));
  51.   END;
  52. END GadgetsLoeschen;
  53.  
  54. (***************************************************************)
  55. PROCEDURE MaleBlock(y : INTEGER);
  56. VAR x : INTEGER;
  57. BEGIN
  58.   FOR x := 1 TO y DO
  59.     SetAPen(wiPtr^.rPort,x);
  60.     RectFill(wiPtr^.rPort,460,(x-1)*34 + 15,510,(x-1)*34 + 44);
  61.   END;
  62.   IF y < 14 THEN
  63.     FOR x := y+1 TO 14 DO
  64.       SetAPen(wiPtr^.rPort,0);
  65.       RectFill(wiPtr^.rPort,460,(x-1)*34 + 15,510,(x-1)*34 + 44);
  66.     END;
  67.   END;
  68. END MaleBlock;
  69.  
  70. (***************************************************************)
  71. PROCEDURE TextEinrichten(id,len : INTEGER);
  72. VAR leer : IntuiText;
  73. BEGIN
  74.   SetAPen(wiPtr^.rPort,5);
  75.   RectFill(wiPtr^.rPort,566,66+((id-1)*100),596,88+((id-1)*100));
  76.   WITH ZahlText[id] DO
  77.     leftEdge  := gadDim[id,1];     topEdge := gadDim[id,2];
  78.     frontPen  := 0;     backPen := 5;
  79.     drawMode  := jam2;
  80.     iText     := ADR(text[len]);
  81.     iTextFont := NIL;
  82.     nextText  := NIL;
  83.   END;
  84.   PrintIText(wiPtr^.rPort,ADR(ZahlText[id]),0,0);
  85. END TextEinrichten;
  86.  
  87. (***************************************************************)
  88. PROCEDURE InitGadget(le,te,wi,he,id : INTEGER);
  89. VAR    stelle : INTEGER;
  90. BEGIN
  91.   WITH BoolGad[id] DO
  92.     leftEdge       :=  le;
  93.     topEdge       :=  te;
  94.     width       :=  wi;
  95.     height      :=  he;
  96.     flags       :=  GadgetFlagSet{};
  97.     activation      :=  ActivationFlagSet{gadgImmediate,relVerify};
  98.     gadgetType      :=  boolGadget;
  99.     gadgetRender :=  NIL;
  100.     gadgetText      :=  NIL;
  101.     mutualExclude:=  LONGSET{};
  102.     nextGadget      :=  NIL;
  103.     selectRender :=  NIL;
  104.     specialInfo  :=  NIL;
  105.     userData     :=  NIL;
  106.     gadgetID      :=  id;
  107.   END;
  108.   IF ((id > 0) AND (id < 9)) OR (id > 16) THEN
  109.     BoolGad[id].flags := gadgHNone;
  110.   END;
  111.   stelle := AddGadget(wiPtr,ADR(BoolGad[id]),-1);
  112.   RefreshGadgets(ADR(BoolGad[id]),wiPtr,NIL);
  113. END InitGadget;
  114.  
  115. (***************************************************************)
  116. PROCEDURE FestGadgetAufbau(wPtr : WindowPtr);
  117. VAR x : INTEGER;
  118. BEGIN
  119.   wiPtr := wPtr;
  120.   gadDim[1,1]:=568;gadDim[1,2]:=72;gadDim[1,3]:=30;gadDim[1,4]:=25;
  121.   gadDim[2,1]:=568;gadDim[2,2]:=172;gadDim[2,3]:=30;gadDim[2,4]:=25;
  122.   gadDim[3,1]:=525;gadDim[3,2]:=55;gadDim[3,3]:=27;gadDim[3,4]:=34;
  123.   gadDim[4,1]:=610;gadDim[4,2]:=55;gadDim[4,3]:=27;gadDim[4,4]:=34;
  124.   gadDim[5,1]:=525;gadDim[5,2]:=152;gadDim[5,3]:=27;gadDim[5,4]:=34;
  125.   gadDim[6,1]:=610;gadDim[6,2]:=152;gadDim[6,3]:=27;gadDim[6,4]:=34;
  126.   gadDim[7,1]:=532;gadDim[7,2]:=16;gadDim[7,3]:=95;gadDim[7,4]:=25;
  127.   gadDim[8,1]:=532;gadDim[8,2]:=116;gadDim[8,3]:=95;gadDim[8,4]:=25;
  128.   gadDim[9,1]:=532;gadDim[9,2]:=226;gadDim[9,3]:=95;gadDim[9,4]:=25;
  129.   gadDim[10,1]:=532;gadDim[10,2]:=266;gadDim[10,3]:=95;gadDim[10,4]:=25;
  130.   gadDim[11,1]:=532;gadDim[11,2]:=306;gadDim[11,3]:=95;gadDim[11,4]:=25;
  131.   gadDim[12,1]:=532;gadDim[12,2]:=346;gadDim[12,3]:=95;gadDim[12,4]:=25;
  132.   gadDim[13,1]:=532;gadDim[13,2]:=386;gadDim[13,3]:=95;gadDim[13,4]:=25;
  133.   gadDim[14,1]:=532;gadDim[14,2]:=426;gadDim[14,3]:=95;gadDim[14,4]:=25;
  134.   gadDim[15,1]:=532;gadDim[15,2]:=471;gadDim[15,3]:=95;gadDim[15,4]:=25;
  135.   gadDim[16,1]:=412;gadDim[16,2]:=18;gadDim[16,3]:=26;gadDim[16,4]:=477;
  136.   (* Farbtafeln *)
  137.  
  138.   FOR x := 17 TO 30 DO (* 14 mögliche Farben *)
  139.     gadDim[x,1] := 460; gadDim[x,2] := (x-17)*34 + 15;
  140.     gadDim[x,3] := 50; gadDim[x,4] := 33;
  141.   END;
  142.   FOR x := 1 TO 30 DO
  143.     InitGadget(gadDim[x,1],gadDim[x,2],gadDim[x,3],gadDim[x,4],x);
  144.   END;
  145.   TextEinrichten(1,8);
  146.   TextEinrichten(2,8);
  147. END FestGadgetAufbau;
  148.  
  149.  
  150. (***************************************************************)
  151. PROCEDURE FlexGadgetAufbau(stellenAnzahl : INTEGER);
  152. VAR gadNum : INTEGER;
  153.     rahmenXPos : ARRAY [31..45] OF INTEGER;
  154.     eckDaten : ARRAY [1..10] OF INTEGER;
  155.     rahmen : Border;
  156. BEGIN
  157.   sta := stellenAnzahl;
  158.   rahmenWeite := 320 DIV stellenAnzahl;
  159.   YPos := rahmenWeite  DIV 2;
  160.   FOR gadNum := 31 TO 30 + stellenAnzahl DO
  161.     rahmenXPos[gadNum] := (gadNum - 31) * rahmenWeite;
  162.     eckDaten[1] := rahmenXPos[gadNum] + 3;
  163.     eckDaten[2] := 3;
  164.     eckDaten[3] := rahmenXPos[gadNum] + rahmenWeite - 6;
  165.     eckDaten[4] := 3;
  166.     eckDaten[5] := rahmenXPos[gadNum] + rahmenWeite - 6;
  167.     eckDaten[6] := rahmenWeite - 6;
  168.     eckDaten[7] := rahmenXPos[gadNum] + 3;
  169.     eckDaten[8] := rahmenWeite - 6;
  170.     eckDaten[9] := rahmenXPos[gadNum] + 3;
  171.     eckDaten[10] := 3;
  172.     WITH rahmen DO
  173.       leftEdge := 0;
  174.       topEdge  := 0;
  175.       frontPen := 14;
  176.       backPen  := 4;
  177.       drawMode := jam1;
  178.       count    := 5;
  179.       xy       := ADR(eckDaten);
  180.       nextBorder := NIL;
  181.     END;
  182.     DrawBorder(wiPtr^.rPort,ADR(rahmen),0,0);
  183.     InitGadget(rahmenXPos[gadNum]+3,3,rahmenWeite-6,rahmenWeite-6,gadNum);
  184.   END;
  185. END FlexGadgetAufbau;
  186.  
  187. (*******************************************************)
  188. (* Ist ns = 15 wurde OK übergeben - alles war gelöst.  *)
  189. (* Ist fus = 16 wurde die Hilfe beansprucht *)
  190. (*******************************************************)
  191. PROCEDURE Auswerten(fus,ns : INTEGER);
  192. VAR nsText,fusText : IntuiText;
  193.     i,x : INTEGER;
  194. BEGIN
  195.   WITH fusText DO
  196.     leftEdge  := 335;     topEdge := YPos;
  197.     frontPen  := 5;     backPen := 0;
  198.     drawMode  := jam2;
  199.     iText     := ADR(text[fus]);
  200.     iTextFont := NIL;
  201.     nextText  := NIL;
  202.   END;
  203.   IF fus = 16 THEN
  204.     fusText.iText := ADR("DAS WAR MIT HILFE !");
  205.     fusText.leftEdge := 20;
  206.   ELSIF fus = sta THEN
  207.     fusText.iText := ADR("ALLES RICHTIG");
  208.     fusText.leftEdge := 70;
  209.   END;
  210.   PrintIText(wiPtr^.rPort,ADR(fusText),0,0);
  211.  
  212.   IF fus < 15 THEN
  213.     WITH nsText DO
  214.       leftEdge  := 360;     topEdge := YPos;
  215.       frontPen  := 5;     backPen := 0;
  216.       drawMode  := jam2;
  217.       iText     := ADR(text[ns]);
  218.       iTextFont := NIL;
  219.       nextText  := NIL;
  220.     END;
  221.     PrintIText(wiPtr^.rPort,ADR(nsText),0,0);
  222.   END;
  223.  
  224.   IF ns # 15 THEN
  225.     ScrollRaster(wiPtr^.rPort,0,-rahmenWeite,0,0,390,512);
  226.     FOR x := 31 TO 31+sta DO
  227.       i := RemoveGadget(wiPtr,ADR(BoolGad[x]));
  228.     END;
  229.     FlexGadgetAufbau(sta);
  230.   END;
  231. END Auswerten;
  232.  
  233. (************************************************************************)
  234. PROCEDURE StellenUndFarben(VAR stellenAnzahl,farbAnzahl : INTEGER);
  235. VAR
  236.   gadPtr    : GadgetPtr;
  237.   gadNr        : INTEGER;
  238.   msgPtr    : IntuiMessagePtr;
  239.   class     : IDCMPFlagSet;
  240.   x, y        : INTEGER;
  241.   code        : CARDINAL;
  242.   fertig    : BOOLEAN;
  243. BEGIN
  244.   MaleBlock(8);
  245.   fertig := FALSE;
  246.   REPEAT
  247.     WaitPort(wiPtr^.userPort);
  248.     LOOP
  249.       msgPtr := GetMsg(wiPtr^.userPort);
  250.       IF msgPtr=NIL THEN EXIT END;
  251.  
  252.       x     := msgPtr^.mouseX;
  253.       y     := msgPtr^.mouseY;
  254.       class := msgPtr^.class;
  255.       code  := msgPtr^.code;
  256.       gadPtr := msgPtr^.iAddress;
  257.       gadNr := gadPtr^.gadgetID;
  258.  
  259.       ReplyMsg(msgPtr);
  260.  
  261.       IF (class = IDCMPFlagSet{gadgetUp}) THEN
  262.         CASE gadNr OF
  263.         | INTEGER(minusSt): IF stellenAnzahl > 4 THEN
  264.                       DEC(stellenAnzahl);
  265.                       TextEinrichten(1,stellenAnzahl);
  266.                     END;
  267.         | INTEGER(plusSt):  IF stellenAnzahl < 12 THEN
  268.                       INC(stellenAnzahl);
  269.                       TextEinrichten(1,stellenAnzahl);
  270.                     END;
  271.         | INTEGER(minusFb): IF farbAnzahl > 2 THEN
  272.                       DEC(farbAnzahl);
  273.                       MaleBlock(farbAnzahl);
  274.                       TextEinrichten(2,farbAnzahl);
  275.                     END;
  276.         | INTEGER(plusFb):  IF farbAnzahl < 14 THEN
  277.                       INC(farbAnzahl);
  278.                       TextEinrichten(2,farbAnzahl);
  279.                       MaleBlock(farbAnzahl);
  280.                     END;
  281.         | INTEGER(hilfe)  : IF ZeigeHilfen(wiPtr) THEN END;
  282.         | INTEGER(spielen): fertig := TRUE;
  283.         | INTEGER(info)   : ShowReq(wiPtr);
  284.         | INTEGER(ende)   : IF ZeigeAbbruch(wiPtr) THEN
  285.                     Terminate(0);
  286.                      END;
  287.         ELSE
  288.         END;
  289.       END;
  290.       IF fertig THEN EXIT END;
  291.     END; (* LOOP *)
  292.   UNTIL fertig;
  293. END StellenUndFarben;
  294.  
  295. (************************************************************************)
  296. PROCEDURE TipFuellen(gadNum : INTEGER;farbReg : CARDINAL);
  297. BEGIN
  298.   SetAPen(wiPtr^.rPort,farbReg);
  299.   RectFill(wiPtr^.rPort,BoolGad[gadNum].leftEdge+3,BoolGad[gadNum].topEdge+3,
  300.   BoolGad[gadNum].leftEdge+rahmenWeite-6,BoolGad[gadNum].topEdge+rahmenWeite-6);
  301. END TipFuellen;
  302.  
  303.  
  304. (************************************************************************)
  305. (************************************************************************)
  306. BEGIN
  307.   FOR x := 0 TO 15 DO
  308.     text[x,3] := 0C;
  309.     IF x < 10 THEN
  310.       text[x,1] := " ";
  311.       text[x,2] := CHAR(x+48);
  312.     ELSIF x < 15 THEN
  313.       text[x,1] := "1";
  314.       text[x,2] := CHAR(x+38);
  315.     END;
  316.   END;
  317. END Gadget.
  318.